﻿#light

namespace CodeBlock.AMD64

open System
open System.Linq

type Fasm()=
    static member Encode(identifier: string)=
        let encoder result chr =
            if Char.IsLetterOrDigit chr then
                chr :: result
            else
                let code = uint16 chr
                let ith_q value i =
                    let result = ((value >>> i) &&& 0xFus)
                    if result < 10us then result.ToString().[0]
                    else char (uint16 'A' + result - 10us)
                
                ith_q code 3 :: ith_q code 2 :: ith_q code 1 :: ith_q code 0 :: '_' :: result
        
        let array = (identifier.ToCharArray()) |> List.of_array |> List.fold encoder [] |> List.rev |> List.to_array
        String(array)
    
    [<OverloadID("operand")>]
    static member Assembly (operand: Operand) =
        match operand with
        | Immediate(imm) ->
            if imm.Base = null then
                imm.Value.ToString()
            elif imm.Value = 0L then
                "L_" + (Fasm.Encode imm.Base)
            else
                "L_" + (Fasm.Encode imm.Base) + "+" + imm.Value.ToString()
        
        | Register(reg) -> reg.ToString()
        | Memory(mem) ->
            let inner =
                if mem.UseRIP then
                    Fasm.Assembly (Immediate mem.Displacement)
                else
                    let baseRegister = if mem.Base = None then null else "R" + mem.Base.Value.ToString()
                    let index = if mem.Index = None then null else "R" + mem.Index.Value.ToString() + "*" + mem.Scale.ToString()
                    if (baseRegister = null) && (index = null) then
                        "qword " + Fasm.Assembly (Immediate mem.Displacement)
                    elif baseRegister = null then
                        index + " + " + Fasm.Assembly (Immediate mem.Displacement)
                    elif index = null then
                        baseRegister + " + " + Fasm.Assembly (Immediate mem.Displacement)
                    else
                        baseRegister + " + " + index + " + " + Fasm.Assembly (Immediate mem.Displacement)
            
            "[" + inner.Replace("+ -", "- ") + "]"
    
    [<OverloadID("operands")>]
    static member Assembly (operands: Operand list) =
        operands |> List.fold_left (fun result curr -> (if result = "" then " " else result + ", ") + Fasm.Assembly curr) ""
    
    [<OverloadID("instruction")>]
    static member Assembly (instruction: InstructionAMD64) =
        match instruction.Operation, instruction.Operands with
        | Operation.Comment, _ -> 
            instruction.Operands 
            |> List.fold_left (fun result curr -> result + " " + (match curr with Immediate(value) -> value.Base)) ";"
        | Operation.Label, Immediate(label) :: [] ->
            Fasm.Assembly (Immediate label) + ":"
        | Operation.Push, Memory(mem) :: [] | Operation.Pop, Memory(mem) :: [] ->
            instruction.Operation.ToString() + " qword " + Fasm.Assembly (Memory mem)
        | op, operands ->
            let operands = operands |> Fasm.Assembly
            op.ToString() + operands
    
    [<OverloadID("func")>]
    static member Assembly(func: #(InstructionAMD64 seq)) =
        let func = List.of_seq func
        
        if func.First().Operation <> Operation.Label then
            failwith "label indicating function name must be first operator"
        
        let head = "format MS64 COFF\n" +
                        "section '.text' code readable executable\n"
        
        let used = Optimize.UsedSymbols func
        let declared = Optimize.DeclaredSymbols func
        let externs = used - declared
        
        let externs =
            externs
            |> Set.fold_left (fun result ext -> "extrn " + (Fasm.Assembly (Immediate (ImmediateOperand (ext)))) + "\n" + result) ""
        
        let externs =
            "public " + Fasm.Assembly (func.Head.Operands.Head) + "\n"
            + externs
        
        let code =
            func
            |> List.fold_left (fun result instr -> result + Fasm.Assembly instr + "\n") ""
        
        head + "\n" + code + "\n" + externs + "\n"
